MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 04 - 1988/04.05 May 88/LSP PalFun Stuff/PalFun

Text File | 1988-04-14 | 5.8 KB | 268 lines | [TEXT/PJMM]

{        PalFun by Steve Sheets 3/88    }

{        Palette Manager Sample Program designed for MacTutor.    }
{        It demonstrate various Palette Animation effects.    }

PROGRAM PalFun;

    USES
        ROM85, ColorQuickDraw, ColorWindowMgr, PaletteMgr, PickerIntf, PalFunGlobals, PalFunStuff;


{******************** Main Portion Programs ********************}

    PROCEDURE crash;
    BEGIN
        ExitToShell;
    END;

{Set Up the normal Mac Interface}
    PROCEDURE SetUp;
        VAR
            count : integer;
    BEGIN
{Standard Mac Program setup}
        InitGraf(@thePort);
        InitFonts;
        FlushEvents(everyEvent, 0);
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(@crash);
        InitCursor;

        FOR count := appleM TO menuCount DO
            myMenus[count] := GetMenu(count);
        AddResMenu(myMenus[appleM], 'DRVR');
        FOR count := appleM TO menuCount DO
            BEGIN
                moveHHi(handle(myMenus[count]));
                HLock(handle(myMenus[count]));
            END;
        FOR count := appleM TO menuCount DO
            InsertMenu(myMenus[count], 0);
        DrawMenuBar;

        WITH screenBits.bounds DO
            SetRect(dragRect, 4, 24, right - 4, bottom - 4);
        doneFlag := FALSE;

        FOR count := 1 TO numWindows DO
            BEGIN
                MyWindow[count] := NIL;
                MyPalette[count] := NIL;
            END;
    END;

{Given a Window ID number, close Window/Palette}
    PROCEDURE CloseIt (N : INTEGER);
    BEGIN
        IF (N > 0) AND (N <= numWindows) THEN
            BEGIN
                IF MyPalette[N] <> NIL THEN
                    DisposePalette(MyPalette[N]);
                MyPalette[N] := NIL;
                IF MyWindow[N] <> NIL THEN
                    DisposeWindow(MyWindow[N]);
                MyWindow[N] := NIL;
            END;
    END;

{Gets the Front most Window ID number.}
    FUNCTION GetWindowNum (W : WindowPtr) : INTEGER;
        VAR
            N, count : INTEGER;
    BEGIN
        IF W = NIL THEN
            GetWindowNum := 0
        ELSE
            BEGIN
                N := 0;
                FOR count := 1 TO numWindows DO
                    IF MyWindow[count] = W THEN
                        N := count;
                GetWindowNum := N;
            END;
    END;

{Standard Handling of the Menu.  Selecting the Window Menu, bring that window}
{    to the front and that's all (Palette Manager handles changing colors and}
{    creating update).  Animate Menu animate the front window if it can.}
    PROCEDURE DoCommand (mResult : LONGINT);
        VAR
            theItem : INTEGER;
            theMenu : INTEGER;
            name : Str255;
            N : INTEGER;
            dummy : Boolean;
            tempPort : GrafPtr;
    BEGIN
        theItem := LoWord(mResult);
        theMenu := HiWord(mResult);
        CASE theMenu OF
            appleM :
                IF theItem = 1 THEN
                    theItem := Alert(AlertID, NIL)
                ELSE
                    BEGIN
                        GetItem(myMenus[appleM], theItem, name);
                        N := OpenDeskAcc(name);
                    END;
            fileM :
                CASE theItem OF
                    1 :
                        BEGIN
                            GetPort(tempPort);
                            SetPort(FrontWindow);
                            CASE GetWindowNum(FrontWindow) OF
                                ballW :
                                    AnimBall;
                                shapeW :
                                    AnimShape;
                                rainbowW :
                                    AnimRainbow;
                                fadeW :
                                    AnimFade;
                                OTHERWISE
                            END;
                            SetPort(tempPort);
                        END;
                    2 :
                        CloseIt(GetWindowNum(FrontWindow));
                    4 :
                        doneFlag := TRUE;
                    OTHERWISE
                END;
            editM :
                dummy := SystemEdit(theItem - 1);
            winM :
                IF (theItem > 0) AND (theItem <= numWindows) THEN
                    BEGIN
                        IF MyWindow[theItem] = NIL THEN
                            BEGIN
                                CASE theItem OF
                                    redW :
                                        MakeRed;
                                    greenW :
                                        MakeGreen;
                                    blueW :
                                        MakeBlue;
                                    ballW :
                                        MakeBall;
                                    curW :
                                        MakeCur;
                                    shapeW :
                                        MakeShape;
                                    rainbowW :
                                        MakeRainbow;
                                    fadeW :
                                        MakeFade;
                                    OTHERWISE
                                END;
                            END
                        ELSE
                            SelectWindow(MyWindow[theItem]);
                    END;
            OTHERWISE
        END;
        HiliteMenu(0);
    END;

{Extremely Standard Main Program Loop.}
    PROCEDURE DoMainLoop;
        VAR
            theChar : CHAR;
            myEvent : EventRecord;
            whichWindow : WindowPtr;
            oldPort : GrafPtr;
            dummy : boolean;
    BEGIN
        REPEAT
            SystemTask;
            IF GetNextEvent(everyEvent, myEvent) THEN
                CASE myEvent.what OF
                    mouseDown :
                        CASE FindWindow(myEvent.where, whichWindow) OF
                            inSysWindow :
                                SystemClick(myEvent, whichWindow);
                            inMenuBar :
                                DoCommand(MenuSelect(myEvent.where));
                            inGoAway :
                                IF TrackGoAway(whichWindow, myEvent.where) THEN
                                    CloseIt(GetWindowNum(whichWindow));
                            inDrag :
                                IF (FrontWindow <> whichWindow) THEN
                                    SelectWindow(whichWindow)
                                ELSE
                                    DragWindow(whichWindow, myEvent.where, dragRect);
                            inContent :
                                IF (FrontWindow <> whichWindow) THEN
                                    SelectWindow(whichWindow);
                            OTHERWISE
                        END; {of mouseDown}
                    keyDown, autoKey :
                        BEGIN
                            theChar := CHR(BitAnd(myEvent.message, charCodeMask));
                            IF BitAnd(myEvent.modifiers, cmdKey) <> 0 THEN
                                DoCommand(MenuKey(theChar));
                        END;
                    updateEvt :
                        BEGIN
                            whichWindow := WindowPtr(myEvent.message);
                            IF whichWindow <> NIL THEN
                                BEGIN
                                    GetPort(oldPort);
                                    SetPort(whichWindow);
                                    BeginUpdate(whichWindow);
                                    CASE GetWindowNum(whichWindow) OF
                                        redW :
                                            DoRedUpdate;
                                        greenW :
                                            DoGreenUpdate;
                                        blueW :
                                            DoBlueUpdate;
                                        curW :
                                            DoCurUpdate;
                                        ballW :
                                            DoBallUpdate;
                                        shapeW :
                                            DoShapeUpdate;
                                        rainbowW :
                                            DoRainbowUpdate;
                                        fadeW :
                                            DoFadeUpdate;
                                        OTHERWISE
                                    END;
                                    EndUpdate(whichWindow);
                                    SetPort(oldPort);
                                END;
                        END;
                    OTHERWISE
                END;
        UNTIL doneFlag;
    END;

{Dispose of all the Palettes and closes all the Windows.}
    PROCEDURE CloseDown;
        VAR
            count : integer;
    BEGIN
        FOR count := 1 TO numWindows DO
            CloseIt(count);
        FOR count := appleM TO menuCount DO
            BEGIN
                DeleteMenu(count);
                DisposeMenu(myMenus[count]);
            END;
        DrawMenuBar;
    END;

{Main Body Program.  Setup, Do it, Close down.}
BEGIN
    IF ColorQDExists THEN
        BEGIN
            SetUp;
            DoMainLoop;
            CloseDown;
        END;
END.